home *** CD-ROM | disk | FTP | other *** search
/ The Business Master (3rd Edition) / The Business Master (3rd Edition).iso / files / datature / omahadb / data.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1988-11-05  |  23.1 KB  |  453 lines
  1. 90  GOTO 1000
  2. 100  REM INSERT CALCULATIONS TO BE MADE DURING DATA ENTRY                            REMEMBER F=FILE, Y=FIELD
  3. 101  REM change line 3405
  4. 102  RETURN
  5. 110  IF F=2 THEN LSET X$(F,9)=STR$(VAL(X$(F,1))+VAL(X$(F,3))+VAL(X$(F,5))+VAL(X$(F,7))):LSET X$(F,10)=STR$(VAL(X$(F,2))+VAL(X$(F,4))+VAL(X$(F,6))+VAL(X$(F,8))):LSET X$(F,11)=STR$(VAL(X$(F,9))+VAL(X$(F,10))):GOSUB 6100
  6. 300  RETURN
  7. 1000  REM ******* DATA PROGRAM ******
  8. 1005  D$=CHR$(0)+"*":ZER$=MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)
  9. 1010  'ON ERROR GOTO 30000
  10. 1011  OPEN "DD" FOR INPUT AS 1: INPUT #1,DR$:CLOSE
  11. 1020  DIM U%(22):FOR I=0 TO 21:READ U%(I):NEXT:DATA&H8B55,&HB8EC,&H0600,&H07B7,&H768B,&H8A0C,&H8B2C,&HA76,&HC8A,&H768B,&H8A08,&H8B34,&H676,&H148A,&HCDFE,&HC9FE,&HCEFE,&HCAFE,&H10CD,&HCA5D,&H8,&H0
  12. 1035  F1=0:F2=1:F3=2: REM DEFAULT DATA ENTRY PARAMETERS
  13. 1040  DEF FNPN(S)=CVI(MID$(P$(0),S*2-1,2))
  14. 1041  DEF FNMFP(F)=CVI(MID$(P$(F),1,2))
  15. 1042  DEF FNNP(F)=CVI(MID$(P$(F),3,2))
  16. 1043  DEF FNL(Y)=7+(Y MOD 10)+(-10*(Y MOD 10 = 0))
  17. 1048  MF$="###################,.##"
  18. 1050  IF CHR$(SCREEN(2,27))<>"T" THEN CLS: COLOR 0,7:PRINT SPACE$(240):LOCATE 2,27:PRINT "The Omaha DataBase Program":LOCATE 1,1:PRINT"KEY";STRING$(78,"THEN");"CLOSE":LOCATE 2,1:PRINT "OPEN":LOCATE 2,80:PRINT "OPEN":LOCATE 3,1:PRINT "SCREEN";STRING$(78,"THEN");"LOAD": COLOR 7,0
  19. 1060  KEY OFF:FOR G=1 TO 10:KEY G,"":NEXT
  20. 1070  LIN$="F1 "+CHR$(24)+" F2 "+CHR$(25)+" F3 SUB"+CHR$(24)+" F4 SUB"+CHR$(25)+" F5 SUB"+CHR$(26)+" F6 MAS"+CHR$(26)+" F7 ANY# F8 DEL  F9 ORGNAL F10 RETURN"
  21. 1071  LIN2$="F1 "+CHR$(27)+"   F2 "+CHR$(26)+"   F3 "+CHR$(24)+"   F4 "+CHR$(25)+"   F5 "+CHR$(27)+"MAS F6 MAS"+CHR$(26)+" F7 ORDER F8 MORE F9 ANY # F10 RETRN"
  22. 1080  DIM X$(6,50),T$(6,50),BB(6,50),BL(6,50),T(6,50)
  23. 1090  RESET:GOSUB 1130
  24. 1100  LOCATE 2,3:PRINT TIME$:LOCATE 2,69:PRINT DATE$
  25. 1120  GOSUB 1130: GOSUB 1180:GOTO 2000
  26. 1130  R1%=4:R2%=24:C1%=1:C2%=80:GOTO 1160: REM SCREEN CLEAR
  27. 1140  R1%=4:R2%=19:C1%=1:C2%=80:GOTO 1160: REM SCREEN CLEAR
  28. 1150  R1%=21:R2%=23:C1%=2:C2%=78:GOTO 1160: REM BOX CLEAR
  29. 1155  R1%=8:R2%=19:C1%=2:C2%=78:GOTO 1160:
  30. 1160  DEF SEG: SUBRT%=VARPTR(U%(0)):CALL SUBRT%(R1%,C1%,R2%,C2%):RETURN
  31. 1170  LOCATE 20,1: PRINT "KEY";STRING$(77,"THEN");"CLOSE":LOCATE 21,1:PRINT "OPEN":LOCATE 21,79:PRINT "OPEN":LOCATE 22,1:PRINT "OPEN":LOCATE 22,79:PRINT "OPEN":LOCATE 23,1:PRINT"OPEN":LOCATE 23,79:PRINT"OPEN";:LOCATE 24,1:PRINT "SCREEN";STRING$(77,"THEN");"LOAD";:RETURN:REM BOX
  32. 1180  REM FORMAT FILE
  33. 1190  F$=DR$+":FORMAT"
  34. 1200  OPEN F$ FOR INPUT AS #7:
  35. 1210  FOR F=0 TO 6:IF EOF(7) THEN 1220 ELSE INPUT #7,F$(F),LL(F),TE(F),DR$(F):FOR Y=1 TO TE(F):INPUT #7,T$(F,Y),T(F,Y),BB(F,Y),BL(F,Y):NEXT:NEXT
  36. 1220  CLOSE:TF=F-1
  37. 1230  RETURN
  38. 1240  PLAY "MB":FOR I9=1 TO 3:FOR J9=2 TO 4:PLAY "L64T255O=J9;CC#DD#EFF#GG#AA#B":NEXT:NEXT:RETURN
  39. 1250  PLAY "MB":FOR I9=1 TO 2:FOR J9=2 TO 4:PLAY "L64T255O=J9;D#EFF#GG#A":NEXT:NEXT:RETURN
  40. 1260  PLAY "MB":FOR I9=1 TO 6:FOR J9=2 TO 4:PLAY "L64T200O=J9;DEFGA":NEXT:NEXT:RETURN
  41. 1270  LOCATE 23,3: COLOR 15:PRINT "INCORRECT ENTRY":COLOR 7,0:GOSUB 1260:GOSUB 1260:GOSUB 1150:RETURN
  42. 1275  LOCATE 23,3: COLOR 15:PRINT "TOO HIGH!!":COLOR 7,0:GOSUB 1260:GOSUB 1260:GOSUB 1150:RETURN
  43. 1276  LOCATE 23,3: COLOR 15:PRINT "NO RECORD TO DELETE!!!":COLOR 7,0:GOSUB 1260:GOSUB 1150:RETURN
  44. 1277  LOCATE 23,3:COLOR 15: PRINT "SUB-FILE NOT LINKED WITH MASTER FILE":COLOR 7,0:GOSUB 1260:GOSUB 1260:GOSUB 1150:RETURN
  45. 1278  LOCATE 23,3:COLOR 15: PRINT "PROBLEM WITH LATERAL LINKAGE: REPAIR THIS FILE!":COLOR 7,0:GOSUB 1260:GOSUB 1260:GOSUB 1150:RETURN
  46. 1279  LOCATE 23,3:COLOR 15: PRINT "DELETED RECORD!!!":COLOR 7,0:GOSUB 1250::GOSUB 1150:RETURN
  47. 1800  REM OPEN FILE
  48. 1810  FI$(F)=DR$(F)+":"+F$(F):QZ=4:IF F=0 THEN QZ=10:
  49. 1820  OPEN FI$(F) AS #F+1 LEN=LL(F):FIELD #F+1,QZ AS P$(F):FOR Y=1 TO TE(F)
  50. 1830  IF QZ>510 THEN FIELD #F+1,255 AS Q1$,255 AS Q2$,QZ-510 AS Q3$,BL(F,Y) AS X$(F,Y) ELSE IF QZ>255 THEN FIELD #F+1,255 AS Q1$,QZ-255 AS Q2$,BL(F,Y) AS X$(F,Y) ELSE IF QZ=<255 THEN FIELD #F+1,QZ AS Q1$,BL(F,Y) AS X$(F,Y)
  51. 1840  QZ=QZ+BL(F,Y):NEXT
  52. 1850  RETURN
  53. 1860  FI$=DR$+":REC":OPEN FI$ FOR INPUT AS #7
  54. 1865  FOR G=0 TO TF:IF EOF(7) THEN 1880
  55. 1875  INPUT #7,NR(G),DL(G):NEXT:
  56. 1880  CLOSE #7:FOR G=0 TO TF: IF NR(G)=0 THEN NR(G)=1:
  57. 1890  NEXT
  58. 1900  RETURN: CLOSE #7
  59. 1910  FI$=DR$+":REC":OPEN FI$ FOR OUTPUT AS #7: FOR G=0 TO TF:WRITE#7,NR(G),DL(G):NEXT:CLOSE #7:RETURN
  60. 2000  REM START OF THE PROGRAM
  61. 2010  TIMER ON: ON TIMER (1) GOSUB 8740
  62. 2020  RESET:GOSUB 1130:LOCATE 25,1:PRINT STRING$(79,32);
  63. 2030  RESTORE 2040
  64. 2040  DATA F1  ADD/CHANGE RECORDS,F2  SEARCH,F3  MONITOR DISPLAY OF RECORDS,,,F6  SET ENTRY PARAMETERS ,F7  HELP,F8  DISPLAY FILES/FIELDS,,F10 EXIT
  65. 2050  LOCATE 6,25:COLOR 25: PRINT "PRESS FUNCTION KEY FOR CHOICE":COLOR 7,0
  66. 2060  FOR G=1 TO 10:READ X$:LOCATE 9+G,25:PRINT X$:NEXT
  67. 2070  CH$=INKEY$: IF CH$="" THEN 2070
  68. 2080  IF ASC(LEFT$(CH$,1))=0 THEN 2100
  69. 2090  SOUND 50,3:GOTO 2120
  70. 2100  CH=ASC(MID$(CH$,2)): CH=CH-58
  71. 2110  ON CH GOTO 3270,4000,5000,2120,2120,7000,8000,8480,2120,8540
  72. 2120  SOUND 50,3: LOCATE 23,25: COLOR 9:PRINT "INCORRECT CHOICE":COLOR 7,0:FOR G=1 TO 1000:NEXT:LOCATE 23,25: PRINT "                  ":GOTO 2070
  73. 2130  REM INPUT ROUTINE
  74. 2140  NC=0:R=CSRLIN:C=POS(0):FLAG=0
  75. 2150  IN$="":FLAG=0
  76. 2160  DEF SEG=0:POKE &H6A,0:POKE 1052,PEEK(1050)
  77. 2170  C3=C+LEN(IN$):COLOR 18:IF T(F,Y)<>3 THEN 2180 ELSE C3=C+LEN(IN$)+(-1*(LEN(IN$)=>2))+(-1*(LEN(IN$)=>4))
  78. 2180  LOCATE R,C3:PRINT CHR$(SCREEN(R,C3))
  79. 2190  I$=INKEY$:IF I$="" THEN 2190
  80. 2200  COLOR 0,7:LOCATE R,C+LEN(IN$):PRINT CHR$(SCREEN(R,C+LEN(IN$)))
  81. 2210  IF ASC(LEFT$(I$,1))=0 THEN FLAG=ASC(MID$(I$,2))-58:SOUND 50,3:IF FLAG=55 THEN PFLAG=1:RETURN ELSE RETURN
  82. 2220  IF I$=CHR$(8) AND LEN(IN$)>0 THEN IN$=LEFT$(IN$,LEN(IN$)-1):LOCATE R,C:PRINT IN$;" ":GOTO 2170 ELSE IF I$=CHR$(8) AND LEN(IN$)=0 THEN SOUND 50,3:GOTO 2190
  83. 2230  IF I$<>CHR$(13) THEN NC=1:GOTO 2270
  84. 2240  IF IN$="" THEN NC=0:IN$=X$(F,Y):LSET X$(F,Y)=IN$:RETURN
  85. 2250  IF T(F,Y)<> 3 THEN LOCATE R,C:PRINT LEFT$(IN$+STRING$(50,32),BL(F,Y))
  86. 2260  IF T(F,Y)=4 THEN LOCATE R,C:PRINT USING RIGHT$(MF$,BL(F,Y)+2);VAL(IN$):RETURN ELSE RETURN
  87. 2270  IF I$=CHR$(27) THEN LOCATE R,C:PRINT STRING$(LEN(IN$),32);:GOTO 2170
  88. 2280  IF T(F,Y)=1 THEN 2320
  89. 2290  IF T(F,Y)=2 AND INSTR("0123456789+=-.Ee#",I$)=0 THEN SOUND 50,3:GOTO 2170
  90. 2300  IF T(F,Y)=3 AND INSTR("0123456789",I$)=0 THEN SOUND 50,3:GOTO 2170
  91. 2310  IF T(F,Y)=4 AND INSTR("01234567890+.-",I$)=0 THEN SOUND 50,3:GOTO 2170
  92. 2320  IF LEN(IN$)+1>BL(F,Y) THEN SOUND 50,3:GOTO 2170
  93. 2330  IN$=IN$+I$:WRT=1
  94. 2340  IF T(F,Y)<>3 THEN 2350 ELSE IF VAL(MID$(IN$,1,2))>12 THEN SOUND 50,3:GOTO 2150 ELSE IF VAL(MID$(IN$,3,2))>31 THEN SOUND 50,3:GOTO 2150
  95. 2350  IF T(F,Y)=1 OR T(F,Y)=2 OR T(F,Y)=4 THEN LOCATE R,C:PRINT IN$:GOTO 2170
  96. 2360  IF T(F,Y)=3 THEN LOCATE R,C: PRINT LEFT$(IN$,2);"/";MID$(IN$,3,2);"/";MID$(IN$,5,2):GOTO 2170
  97. 2370  STOP
  98. 2380  REM FLAG HANDLER
  99. 2390  COLOR 7,0:ON FLAG GOTO 2400,2410,2470,2420,2430,2500,2540,2550,2560,2570
  100. 2391  IF PFLAG THEN 8400
  101. 2400  COLOR 7,0: IF Y<>1 AND Y<>E1 OR F=F1 AND Y<>F2 THEN Y=Y-1:COLOR 7,0:LSET X$(F,Y+1)=IN$: RETURN 3380
  102. 2405  IF Y=E1 AND Y<>1 THEN E1=E1-10:E2=E1+9:Y=Y-1:GOSUB 6100:RETURN 3380 ELSE 2170
  103. 2410  IF Y<>TE(F) AND Y<E2 THEN LSET X$(F,Y-1)=IN$:COLOR 7,0:RETURN 3400 ELSE 2600
  104. 2420  IF F<>TF THEN GOSUB 1140:GOSUB 3140:F=F+1:X=FNPN(F):GOSUB 2720:RETURN 3360 ELSE GOTO 2170
  105. 2430  IF WRT<>0 THEN GOSUB 3140
  106. 2440  IF F=0 OR F3=1 THEN X=X+1:GOTO 2460:IF X=NR(F) THEN X=0:GOTO 2460
  107. 2450  IF F<>0 THEN LATLINK=X:X=FNNP(F):IF X=LATLINK THEN X=0
  108. 2455  IF X=0 THEN XM=XM+1: IF XM>0 AND XM<NR(0) THEN GET #1,XM: X=FNPN(F)
  109. 2460  GOTO 2720
  110. 2470  IF F<>0 THEN GOSUB 3140:F=F-1: ELSE 2170:
  111. 2480  IF F<>0 THEN X=FNPN(F):GOSUB 1140:GOSUB 2720:GOSUB 3010:GOSUB 6010:GOTO 2600
  112. 2490  IF F=0 THEN X=FNMFP(F+1):GOSUB 1140:GOSUB 2720:GOSUB 3010:GOSUB 6010:GOTO 2600 ELSE 2170
  113. 2500  IF FLAG=6 THEN GOSUB 3140:FC=F:F=0:X=XM+1:XM=XM+1:GOTO 2720
  114. 2510  IF X=NR(F) THEN X=0:GOSUB 2720:GOSUB 3010:GOTO 2530
  115. 2520  IF DFLAG=1 THEN DFLAG=0: WRT=0:GOTO 2500
  116. 2530  RETURN 3360
  117. 2540  IF FLAG=7 THEN LATLINK=0:LX=0:GOTO 2610
  118. 2550  IF FLAG=8 THEN 2830
  119. 2560  IF FLAG=9 THEN GET #F+1,X:RETURN 3360
  120. 2570  IF WRT=0 AND X+1=NR(F) AND X$(F,1)=STRING$(LEN(X$(F,1)),32) THEN NR(F)=NR(F)-1
  121. 2580  IF WRT=1 THEN GOSUB 3140
  122. 2590  CLOSE:GOSUB 1910:RUN
  123. 2600  RETURN
  124. 2610  REM INPUT NEW RECORD #
  125. 2620  COLOR 15:LOCATE 2,10:PRINT F:LOCATE 2,15:PRINT LEFT$(F$(F)+"             ",10):LOCATE 2,45:PRINT " /";NR(F)-1;"    ":LOCATE 2,74:PRINT XM;"  ":COLOR 7,0
  126. 2630  GOSUB 3140:GOSUB 1150: RX$="":LOCATE 22,3: IF F3=1 THEN PRINT "New Record Number (Physical order) ==> ";:GOTO 2650
  127. 2640  IF F3=2 THEN PRINT "New Record Number (Linked Order) ==> ";:RX$=""
  128. 2650  R=CSRLIN:C=POS(0)
  129. 2660  G$=INKEY$: IF G$="" THEN 2660
  130. 2670  IF G$=CHR$(13) THEN 2710
  131. 2680  IF ASC(LEFT$(G$,1))=0 THEN FLAG=ASC(MID$(G$,2))-58:SOUND 50,3:GOTO 2380
  132. 2690  IF G$=CHR$(8) AND LEN (RX$)>0 THEN RX$=MID$(RX$,1,LEN(RX$)-1):GOTO 2660
  133. 2700  RX$=RX$+G$:LOCATE R,C:PRINT RX$:GOTO 2660
  134. 2710  X=VAL(RX$):GOSUB 1150
  135. 2720  IF X<>0 THEN 2750
  136. 2730  IF DL(F)=0 THEN X=NR(F):NR(F)=NR(F)+1:FOR Y=1 TO TE(F):LSET X$(F,Y)=STRING$(200,32):NEXT:DELFLAG=1:NOREAD=1:LSET P$(F)=MKI$(XM)+ZER$:IF F=0 THEN XM=X:LSET P$(0)=ZER$:RETURN 3360
  137. 2740  IF DL(F)<>0 THEN X=DL(F):GET #F+1,X:DG=CVI(MID$(P$(F),3)):DELFLAG=1:LSET P$(F)=ZER$:FOR Y=1 TO TE(F):LSET X$(F,Y)=STRING$(200,32):NEXT:NOREAD=1:IF F=0 THEN XM=X:RETURN 3360 ELSE IF F<>0 THEN LSET P$(F)=MKI$(XM)+ZER$
  138. 2750  IF X=NR(F) THEN NR(F)=NR(F)+1
  139. 2760  GOSUB 3010: REM read record
  140. 2770  FC=F:XC=X:IF F3=2 AND F<>0 AND XM =0 THEN F=0:X=FNMFP(FC):IF X<>0 THEN NOREAD=0:GOSUB 3010
  141. 2780  F=FC:X=XC
  142. 2790  IF F<>0 AND XM=0 THEN DELFLAG=0:GOSUB 1277:IF NR(F)<=2 THEN NR(F)=1:F=0: X=0:XM=0:XC=0:FC=0:FRST=1:RETURN 3350 ELSE RETURN 3350: REM NEW RECORD NO LINKAGE...NOT ALLOWED
  143. 2800  IF FLAG=4 THEN RETURN
  144. 2810  IF FLAG=3 THEN RETURN 3360
  145. 2820  RETURN 3360
  146. 2830  REM DELETE RECORD
  147. 2840  IF X=0 THEN GOSUB 1276:RETURN 3350
  148. 2850  IF F<>0 THEN 2930
  149. 2860  IF F=0 AND TF<>0 THEN GOSUB 1150: LOCATE 21,3: INPUT "DO YOU WANT TO DELETE ANY RECORDS IN LINKED SUB-FILES (Y/N) ";AN$:IF AN$="y" OR AN$="Y" THEN 2870 ELSE IF AN$="n" OR AN$="N" THEN 2930 ELSE SOUND 50,3:GOSUB 1150:RETURN 3360
  150. 2870  LOCATE 22,3:PRINT "Enter ACCESS code ";:COLOR 31:PRINT "DELETE";:COLOR 7,0:INPUT " to proceed ====> ";AN$: IF AN$<>"DELETE" AND AN$<>"Delete" AND AN$<>"delete" THEN GOSUB 1270: GOTO 2600
  151. 2880  GOSUB 1150: LOCATE 22,3:COLOR 18:PRINT "DELETING SUB-FILE RECORDS":COLOR 7,0
  152. 2890  FC=F:GOSUB 1150:FOR F=TF TO 1 STEP -1: IF FNPN(F)=0 THEN 2910 ELSE X=FNPN(F):GET #F+1,X
  153. 2900  NX=FNNP(F):LSET P$(F)=D$+MKI$(DL(F)):IF X>NR(F) THEN 2910 ELSE FOR Y=1 TO TE(F):LSET X$(F,Y)=STRING$(255,"*"):NEXT:PUT #F+1,X:DL(F)=X:IF NX<>0 THEN X=NX:GET #F+1,X:GOTO 2900
  154. 2910  NEXT F:F=FC
  155. 2920  LSET P$(0)=D$+MKI$(DL(0)): FOR Y=1 TO TE(0):LSET X$(0,Y)=STRING$(50,"*"):NEXT:PUT #1,XM:DL(0)=XM:DELFLAG=1:GOSUB 1910:GOSUB 1150:X=XM:F=0:GOSUB 6010:RETURN 3350
  156. 2930  REM delete record only
  157. 2940  GOSUB 1150:LOCATE 22,3:PRINT "Enter ACCESS code ";:COLOR 31:PRINT "DELETE";:COLOR 7,0:INPUT " to proceed ====> ";AN$: IF AN$<>"DELETE" AND AN$<>"Delete" AND AN$<>"delete" THEN GOSUB 1270: GOTO 2600
  158. 2950  IF F=0 THEN 3000
  159. 2960  IF FNPN(F)=X THEN LSET P$(0)=MID$(P$(0),1,((F-1)*2))+MKI$(FNNP(F))+MID$(P$(0),1+(F*2)): PUT #1,XM:GOTO 3000:REM ERASE POINTER ON MASTER FILE IF FIRST RECORD IS DELETED
  160. 2970  AP=FNNP(F):LX=FNPN(F)
  161. 2980  GET #F+1,LX: IF FNNP(F)=X THEN LATLINK=LX ELSE IF LX<>X THEN LX=FNNP(F):GOTO 2980
  162. 2990  LSET P$(F)=MKI$(XM)+MKI$(AP):PUT #F+1,LX:REM DELETE POINTER ON PREVIOUS RECORD IN THE SAME SUB-FILE AND LINK TO POINTER FROM DELETED RECORD
  163. 3000  LSET P$(F)=D$+MKI$(DL(F)):FOR Y=1 TO TE(F):LSET X$(F,Y)=STRING$(40,"*"):NEXT:PUT #F+1,X:DL(F)=X:DELFLAG=1:WRT=0:GOSUB 1150:GOSUB 6010:RETURN 3350
  164. 3010  REM GET ROUTINE
  165. 3020  IF NOREAD=1 THEN NOREAD=0: RETURN
  166. 3030  IF X=>NR(F) THEN SOUND 50,3:GOSUB 1275:RETURN 3350
  167. 3040  GET #F+1,X:IF LEFT$(P$(F),2)=D$ AND FLAG=6 THEN DFLAG=1:RETURN ELSE IF LEFT$(P$(F),2)=D$ THEN GOSUB 1279:RETURN 2610
  168. 3050  IF F=0 THEN XM=X:RETURN
  169. 3060  IF FNMFP(F)=0 THEN LSET P$(F)=MKI$(XM)+ZER$:GOTO 3080
  170. 3070  GET #1,FNMFP(F):XM=FNMFP(F)
  171. 3080  IF FNPN(F)=X THEN LATLINK=X:RETURN:REM FIRST IN SUB-FILE
  172. 3090  RETURN
  173. 3100  REM FIND LATLINK
  174. 3110  LX=FNPN(F)
  175. 3120  GET #F+1,LX: IF FNNP(F)=X OR FNNP(F)=0 THEN LATLINK=LX ELSE IF LX<> X THEN LX=FNNP(F):GOTO 3120
  176. 3130  RETURN
  177. 3140  REM PUT ROUTINE
  178. 3150  IF FRST=1 THEN FRST=0:RETURN
  179. 3160  IF WRT=0 AND NR(F)-1 <>X THEN RETURN ELSE IF WRT=0 AND NR(F)-1=X AND X$(F,1)=STRING$(LEN(X$(F,1)),32)  THEN NR(F)=X:RETURN:REM RECORD NOT CHANGED
  180. 3165  IF DG<>0 THEN DL(F)=DG: DG=0: GOSUB 1910 :REM make sure deleted record is written on after it is chosen
  181. 3170  WRT=0:IF F<>0 THEN 3190
  182. 3180  PUT #1,X:GOSUB 1910:RETURN
  183. 3190  IF FNPN(F)=0 AND XM <>0 THEN LSET P$(0)=MID$(P$(0),1,(F-1)*2)+MKI$(X)+MID$(P$(0),(F*2)-1): PUT #1,XM: REM MASTER FILE LINKAGE ON FIRST LINKED RECORD IN SUB FILE
  184. 3200  REM LATERAL LINKAGE
  185. 3210  PUT #F+1,X:XC=X:GOSUB 3100:
  186. 3220  IF LATLINK=0 OR LATLINK=X THEN 3250
  187. 3230  IF LATLINK <>0 AND LATLINK <>X THEN GET #F+1,LATLINK:
  188. 3240  IF LATLINK <>0 AND FNMFP(F)=XM AND LATLINK <>XC THEN LSET P$(F)=MID$(P$(F),1,2)+MKI$(X):PUT #F+1,LATLINK: LATLINK=XC
  189. 3250  GET #F+1,XC
  190. 3260  RETURN
  191. 3270  REM ADD/CHANGE RECORDS
  192. 3290  CLS:TIMER OFF:FRST=1:
  193. 3300  GOSUB 1130:GOSUB 1170:COLOR 0,7:LOCATE 25,1:PRINT LIN$;:COLOR 7,0:GOSUB 1170
  194. 3310  COLOR 7,0:LOCATE 2,3:PRINT "FILE #":LOCATE 2,13:PRINT ": ":LOCATE 2,30:PRINT "PHYSICAL RECORD:":LOCATE 2,60:PRINT "MASTER RECORD:"
  195. 3320  LOCATE 1,1:PRINT "KEY";STRING$(78,"THEN");"CLOSE":LOCATE 2,1:PRINT "OPEN";:LOCATE 3,1:PRINT "SCREEN";STRING$(78,"THEN");"LOAD":LOCATE 2,80:PRINT "OPEN":
  196. 3330  COLOR 0,7: LOCATE 25,1:PRINT LIN$;:COLOR 7,0
  197. 3340  FOR F=0 TO TF:GOSUB 1800:NEXT:GOSUB 1860:FRST=1:F=F1
  198. 3350  GOSUB 2610
  199. 3360  GOSUB 6010:NOREAD=0:
  200. 3370  FOR Y=E1 TO E2
  201. 3380  LOCATE 8+Y-E1,17:GOSUB 2130:COLOR 7,0
  202. 3390  IF  FLAG>0 THEN GOSUB 2380
  203. 3395  LSET X$(F,Y)=IN$
  204. 3396  IF NC=0 THEN 3560
  205. 3400  REM INSERT HERE IF F=FILE# THEN GOSUB 100 FOR CALCULATED FIELDS
  206. 3405  IF F=2 THEN GOSUB 100: REM check calculation
  207. 3560  NEXT
  208. 3565  IF Y<=TE(F) THEN GOSUB 1155: GOSUB 6030: GOTO 3370
  209. 3700  IF CHECK<>0 THEN 3750
  210. 3710  LOCATE 21,3: PRINT "You can press 'F4' to go to the next SUB-FILE.":LOCATE 22,3: PRINT "Any Corrections (Y/N/X)  ('X' ..don't ask)                  ";
  211. 3720  A$=INKEY$: IF A$="" THEN 3720 ELSE GOSUB 1150
  212. 3730  IF ASC(LEFT$(A$,1))=0 THEN FLAG=ASC(MID$(A$,2))-58:SOUND 50,3:GOSUB 2380
  213. 3740  IF A$="y" OR A$="Y" THEN 3360 ELSE IF A$="x" OR A$="X" THEN CHECK=1
  214. 3750  GOSUB 3140: REM PUT
  215. 3760  OX=X:IF F=0 THEN X=X+1 ELSE IF F3=2 AND F<>0 THEN X=FNNP(F):
  216. 3770  IF F3=1 THEN X=X+1
  217. 3780  IF X<1 OR X=>NR(F) OR OX=X THEN X=0
  218. 3790  IF X<>0 THEN 3830
  219. 3800  A$="":IF F<>0 AND X=0 THEN SOUND 50,3:GOSUB 1150:LOCATE 21,3:PRINT "Press function keys for next record (F5 will be next linked record)":LOCATE 22,3: PRINT "If you want a new record linked to same master record press 'ENTER'"
  220. 3801  A$=INKEY$: IF A$="" THEN 3801 ELSE GOSUB 1150
  221. 3802  IF ASC(LEFT$(A$,1))=0 THEN FLAG=ASC(MID$(A$,2))-58:SOUND 50,3:GOSUB 2380
  222. 3803  IF ASC(A$)<>13 THEN GOSUB 1270:GOTO 3800
  223. 3805  IF X=0 THEN 3830
  224. 3810  X=FNNP(F)
  225. 3830  GOSUB 2720
  226. 3900  GOTO 3360
  227. 4000  REM SEARCH
  228. 4010  GOSUB 1130:GOSUB 1170:COLOR 9:LOCATE 4,1:PRINT "SEARCH":COLOR 7,0:GOSUB 1860:GOSUB 8670
  229. 4020  SOUND 50,3:LOCATE 22,3: PRINT "Which file for your search  ( 0 -";TF") ";:INPUT F$
  230. 4030  F=VAL(F$): IF F<0 OR F>TF THEN GOSUB 1270:GOTO 4020
  231. 4040  GOSUB 1140:GOSUB 1150:COLOR 9:LOCATE 4,1:PRINT "SEARCH":COLOR 7,0:GOSUB 8570
  232. 4050  SOUND 50,3:LOCATE 22,3: PRINT "Which Field do you want to begin with ( 1 -";TE(F)") ";:INPUT F$
  233. 4060  FI=VAL(F$): IF FI<1 OR FI>TE(F)  THEN GOSUB 1270:GOTO 4050
  234. 4070  GOSUB 1150:LOCATE 21,3:PRINT "Field ====> ";T$(F,FI):LOCATE 22,3:INPUT "Enter item you wish to search for ===> ";SI$
  235. 4080  IF LEN(SI$)>BL(F,FI) THEN GOSUB 1270: GOTO 4070
  236. 4100  GOSUB 1150:LOCATE 21,3:PRINT "NOW ENTER RECORD NUMBER OF ";F$(F)" TO BEGIN SEARCH":LOCATE 22,3:INPUT "Beginning record number ===> ",BN$:BN=VAL(BN$)
  237. 4110  IF BN=0 OR BN>NR(F) THEN BN=1
  238. 4120  GOSUB 1130:GOSUB 1170: COLOR 9:LOCATE 4,1:PRINT "SEARCH":COLOR 7,0
  239. 4130  PRINT "You have indicated that you wish to search"
  240. 4140  LOCATE 8,1:PRINT "   * FILE =====> ";F$(F)
  241. 4150  PRINT "   * FIELD ====> ";T$(F,FI)
  242. 4160  PRINT "   * ITEM =====> ";SI$
  243. 4170  PRINT "   * BEG.# ====> ";BN
  244. 4180  LOCATE 22,3:INPUT "IS THIS OKAY (Y/N) ";AN$: IF AN$="N" OR AN$="n" THEN 4000
  245. 4190  TIMER OFF:CLS:GOSUB 1170
  246. 4200  LOCATE 21,3:PRINT "Press 'Q' to quit the search at any time"
  247. 4205  TIMER OFF:LOCATE 1,1:PRINT "KEY";STRING$(78,"THEN");"CLOSE":LOCATE 2,1:PRINT "OPEN";:LOCATE 3,1:PRINT "SCREEN";STRING$(78,"THEN");"LOAD":LOCATE 2,80:PRINT "OPEN":
  248. 4206  SF=F:F=0:GOSUB 1800:F=SF: IF F<>0 THEN GOSUB 1800
  249. 4210  COLOR 7,0:LOCATE 2,3:PRINT "FILE #":LOCATE 2,13:PRINT ": ":LOCATE 2,30:PRINT "PHYSICAL RECORD:":LOCATE 2,60:PRINT "MASTER RECORD:"
  250. 4220  FOR X=BN TO NR(F): GET #F+1,X
  251. 4230  LOCATE 22,3:PRINT "Searching Record # ";X
  252. 4232  IF INSTR(X$(F,FI),SI$)=0 THEN 4300
  253. 4240  IF F<>0 THEN GET #1,FNMFP(F)
  254. 4245  SOUND 50,3:GOSUB 6000:GOSUB 1150
  255. 4250  IF Y2>TE(F) THEN 4280 ELSE GOSUB 1150:LOCATE 22,3:PRINT "Press any key to continue display of record ";
  256. 4260  A$=INKEY$: IF A$="" THEN 4260
  257. 4270  GOSUB 1155:GOSUB 6030
  258. 4280  GOSUB 1150:LOCATE 22,3:PRINT "Press any key to continue search":
  259. 4290  A$=INKEY$: IF A$="" THEN 4290 ELSE GOSUB 1150:IF A$="q" OR A$="Q" THEN CLOSE:CLS:X=NR(F)+1:RUN
  260. 4300  A$=INKEY$: IF A$="q" OR A$="Q" THEN CLOSE:CLS:X=NR(F)+1:RUN
  261. 4310  NEXT X: CLOSE:CLS:RUN
  262. 5000  REM MONITOR DISPLAY
  263. 5020  TIMER OFF:CLS:FRST=1:
  264. 5030  GOSUB 1130:GOSUB 1170:COLOR 0,7:LOCATE 25,1:PRINT LIN2$;:COLOR 7,0:GOSUB 1170
  265. 5040  COLOR 7,0:LOCATE 2,3:PRINT "FILE #":LOCATE 2,13:PRINT ": ":LOCATE 2,30:PRINT "PHYSICAL RECORD:":LOCATE 2,60:PRINT "MASTER RECORD:"
  266. 5050  LOCATE 1,1:PRINT "KEY";STRING$(78,"THEN");"CLOSE":LOCATE 2,1:PRINT "OPEN";:LOCATE 3,1:PRINT "SCREEN";STRING$(78,"THEN");"LOAD":LOCATE 2,80:PRINT "OPEN":
  267. 5060  GOSUB 1860:FOR F=0 TO TF:GOSUB 1800:NEXT
  268. 5070  FLAG=7:ORD=1:GOSUB 5180:X=1: F=0: GOSUB 5640
  269. 5080  GOSUB 6000
  270. 5090  GOSUB 5130: IF FLAG=8 THEN GOSUB 5150
  271. 5100  GOSUB 5640
  272. 5110  GOSUB 6000:
  273. 5120  GOTO 5090
  274. 5130  LOCATE 22,3:PRINT "ENTER REC.#/FUNCTION KEY ";
  275. 5140  N$=""
  276. 5150  K$=INKEY$: IF K$="" THEN 5150
  277. 5160  IF ASC(LEFT$(K$,1))=0 THEN FLAG=ASC(MID$(K$,2))-58:SOUND 50,3:GOTO 5170 ELSE 5580
  278. 5170  REM FLAG HANDLER
  279. 5180  ON FLAG GOTO 5190,5270,5310,5370,5430,5460,5510,5540,5560,5620
  280. 5190  REM BACKWARD ONE
  281. 5200  IF F=0 THEN X=X-1:XM=X:RETURN
  282. 5210  IF ORD=2 THEN 5220 ELSE X=X-1:IF X<1 THEN X=1:RETURN ELSE RETURN
  283. 5220  IF X<>OX AND OX<>0 THEN X=OX:OX=0:RETURN
  284. 5230  IF X<>FNPN(F) THEN X=FNPN(F):RETURN
  285. 5240  OM=XM
  286. 5250  XM=XM-1: IF XM >0 THEN GET #1,XM: X=FNPN(F): IF X=0 AND XM<>1 THEN 5250 ELSE IF X=0 THEN XM=OM:GET #1,XM:X=FNPN(F)
  287. 5260  RETURN
  288. 5270  REM FORWARD
  289. 5280  IF F=0 THEN X=X+1:XM=X:RETURN
  290. 5290  IF ORD=2 THEN 5300 ELSE X=X+1: IF X=>NR(F) THEN X=NR(F)-1:RETURN ELSE RETURN
  291. 5300  OX=X:X=FNNP(F): RETURN
  292. 5310  REM UP ONE FILE
  293. 5320  F=F-1: IF F<0 THEN F=0
  294. 5330  IF F=0 THEN X=XM
  295. 5340  IF ORD=2 AND F<>0 THEN X=FNPN(F): IF X=0 AND F<>0 THEN 5320
  296. 5350  IF ORD=1 AND F<>0 THEN X=1
  297. 5360  RETURN
  298. 5370  REM DOWN ONE FILE
  299. 5380  F=F+1: IF F>TF THEN F=TF
  300. 5400  IF ORD =2 AND F<>0 THEN X=FNPN(F):IF X=0 AND F<>TF THEN 5380
  301. 5410  IF ORD=1 AND F<>0 THEN X=1
  302. 5420  RETURN
  303. 5430  REM BACK ONE RECORD MASTER
  304. 5440  IF F=0 THEN XM=XM-1: X=XM: IF X<0 THEN X=1:XM=1:RETURN ELSE IF X>0 AND F=0 THEN RETURN
  305. 5450  XM=XM-1:IF XM=0 THEN XM=1:RETURN ELSE  GET #1,XM: X=FNPN(F):IF X=0 THEN 5450 ELSE RETURN
  306. 5460  REM FORWARD ONE RECORD MASTER
  307. 5470  IF F=0 THEN XM=XM+1: X=XM: IF X=>NR(0)  THEN X=NR(0)-1:XM=X:RETURN ELSE RETURN
  308. 5480  XM=XM+1:IF XM<NR(0) THEN GET #1,XM:IF ORD=2 THEN X=FNPN(F):RETURN
  309. 5490  IF XM=>NR(0) THEN XM=NR(0)-1: IF ORD=2 THEN X=FNPN(F):RETURN
  310. 5500  IF ORD=1 THEN F=0: RETURN
  311. 5510  REM ORDER
  312. 5520  IF ORD=2 THEN ORD=1 ELSE ORD=2
  313. 5530  LOCATE 20,60:IF ORD=1 THEN PRINT "PHYSICAL ORDER" ELSE PRINT "LINKAGE  ORDER ":RETURN ELSE RETURN
  314. 5540  REM MORE
  315. 5545  IF E2=TE(F) THEN E2=0: E1=1:GOSUB 1155:RETURN
  316. 5550  GOSUB 1155: GOSUB 6030: RETURN
  317. 5560  GOSUB 1150: LOCATE 22,3: PRINT "ENTER RECORD NUMBER ===> ";
  318. 5570  K$=INKEY$: IF K$="" THEN 5570
  319. 5580  GOSUB 1150: LOCATE 22,3: PRINT "ENTER RECORD NUMBER ===> ";
  320. 5590  N$=N$+K$:IF VAL(N$)=0 THEN 5130 ELSE IF K$=CHR$(13) THEN X=VAL(N$):RETURN
  321. 5600  IF K$=CHR$(8) THEN N$=MID$(N$,1,LEN(N$)-2):
  322. 5610  LOCATE 22,30: PRINT N$:GOTO 5570
  323. 5620  REM RETURN
  324. 5630  CLOSE: RUN
  325. 5640  REM MONITOR DISPLAY/ READ A RECORD
  326. 5650  IF ORD=2 AND X=0 THEN XM=XM+1:IF XM<NR(0) THEN GET#1,XM ELSE X=1:F=0
  327. 5660  IF F<>0 AND ORD=2 AND X=0 THEN X=FNPN(F):GOTO 5650
  328. 5670  IF X<1 OR X=>NR(F) THEN SOUND 50,3: RETURN 5090: REM RECORD TOO LOW OR TOO HIGH
  329. 5680  GET #F+1,X: IF LEFT$(X$(F,1),2)=D$ THEN LOCATE 22,3:PRINT "DELETED RECORD":SOUND 50,3:FOR W=1 TO 2000:NEXT:RETURN 5090
  330. 5690  IF F<>0 THEN XM=FNMFP(F) ELSE XM=X
  331. 5700  IF XM<>0 THEN GET #1,XM
  332. 5710  RETURN
  333. 6000  REM DISPLAY
  334. 6010  FLAG=0:E1=1:E2=0:GOSUB 1140:IF F=F1 THEN E1=F2
  335. 6020  COLOR 15:LOCATE 2,10:PRINT F:LOCATE 2,15:PRINT LEFT$(F$(F)+"             ",10):LOCATE 2,45:PRINT X;"/";NR(F)-1;"    ":IF XM<NR(0) THEN LOCATE 2,74:PRINT XM;" " ELSE LOCATE 2,74: PRINT "*  "
  336. 6030  IF E2<>0 THEN E1=E2+1:GOSUB 1155
  337. 6040  IF E1+9>TE(F) THEN E2=TE(F) ELSE E2=E1+9:GOSUB 1155
  338. 6050  COLOR 7,0:LOCATE 4,5:PRINT "RECORD==> ";:LOCATE 4,16:PRINT X
  339. 6060  IF LEFT$(P$(F),2)=D$ THEN FOR Y=1 TO TE(F):LSET X$(F,Y)=STRING$(200,32):NEXT:LSET P$(F)=ZER$: IF F<>0 THEN LSET P$(F)=MKI$(XM)+ZER$
  340. 6070  IF F<>0 THEN COLOR 7,0:LOCATE 5,5:PRINT "MASTER";:LOCATE 5,16:PRINT FNMFP(F):LOCATE 5,25:PRINT LEFT$(X$(0,1)+X$(0,2)+X$(0,3)+STRING$(50,32),54): LOCATE 6,5: PRINT "LINK";:LOCATE 6,16:PRINT FNNP(F)
  341. 6080  IF F<>0 THEN GOSUB 1155:GOTO 6100 ELSE P=1:COLOR 7,0:LOCATE 5,5:COLOR 9,0:PRINT "POINTERS:":LOCATE 5,16:PRINT "1          2          3          4          5":COLOR 7,0: LOCATE 6,11
  342. 6090   IF P<=TF THEN PRINT MID$("    "+STR$(FNPN(P))+"        ",1,11);:P=P+1:GOTO 6090
  343. 6100  FOR Y2=E1 TO E2:
  344. 6110  COLOR 7,0:LOCATE 8+Y2-E1,1:PRINT LEFT$(STR$(Y2)+". "+T$(F,Y2)+"               ",15);" ";:COLOR 0,7
  345. 6120  IF T(F,Y2)=1 OR T(F,Y2)=2 THEN PRINT X$(F,Y2):GOTO 6150
  346. 6130  IF T(F,Y2)=3 AND LEN(X$(F,Y2))>2 THEN PRINT MID$(X$(F,Y2),1,2);"/";MID$(X$(F,Y2),3,2);"/";MID$(X$(F,Y2),5,2):GOTO 6150 ELSE IF T(F,Y2)=3 THEN PRINT X$(F,Y2):GOTO 6150
  347. 6140  IF T(F,Y2)=4 THEN PRINT USING RIGHT$(MF$,BL(F,Y2)+2);VAL(X$(F,Y2))
  348. 6150  NEXT Y2:COLOR 7,0:
  349. 6160  RETURN
  350. 7000  REM SET ENTRY PARAMETERS
  351. 7010  GOSUB 1130:GOSUB 1170:COLOR 9:LOCATE 4,1:PRINT "SET ENTRY PARAMETERS":COLOR 7,0:GOSUB 8670
  352. 7020  SOUND 50,3:LOCATE 22,3: PRINT "Which file do you want to begin with ( 0 -";TF") ";:INPUT F$
  353. 7030  F1=VAL(F$): IF F1<0 OR F1>TF THEN GOSUB 1270:GOTO 7020
  354. 7040  F=F1:GOSUB 1140:GOSUB 1150:COLOR 9:LOCATE 4,1:PRINT "SET ENTRY PARAMETERS":COLOR 7,0:GOSUB 8570
  355. 7050  SOUND 50,3:LOCATE 22,3: PRINT "Which Field do you want to begin with ( 1 -";TE(F1)") ";:INPUT F$
  356. 7060  F2=VAL(F$): IF F2<1 OR F2>TE(F1)  THEN GOSUB 1270:GOTO 7060
  357. 7070  IF F1=0 THEN 7100
  358. 7080  GOSUB 1150:SOUND 50,3:LOCATE 21,3:PRINT "Do you want (1) PHYSICAL order or (2) LINKAGE (Master File) order":LOCATE 22,3:INPUT "Order (1 or 2) ======> ";F$
  359. 7090  F3=VAL(F$): IF F3<1 OR F3>2 THEN GOSUB 1270:GOTO 7080
  360. 7100  GOSUB 1130:GOSUB 1170:COLOR 9:LOCATE 5,20:PRINT "SET ENTRY PARAMETERS":COLOR 15
  361. 7110  LOCATE 8,20: PRINT "FILE TO BEGIN WITH     ";F1". ";F$(F1)
  362. 7120  LOCATE 10,20: PRINT "FIELD TO BEGIN WITH    ";F2". ";T$(F1,F2)
  363. 7130  LOCATE 12,20:PRINT  "ORDER                  ";:IF F3=1 THEN PRINT "PHYSICAL" ELSE PRINT "LINKAGE"
  364. 7140  SOUND 50,3:COLOR 7,0:LOCATE 22,3: INPUT "Is this Correct (Y/N)               ";AN$:IF AN$= "n" OR AN$="N" THEN 7000
  365. 7150  CLOSE:GOTO 2000
  366. 8000  REM HELP SCREEN
  367. 8010  GOSUB 1130:GOSUB 1170:COLOR 9:LOCATE 5,1:PRINT "SET ENTRY PARAMETERS":COLOR 7,0
  368. 8020  PRINT:PRINT"You are able to set the file and field that you wish to start with. For example if you wish to enter data into sub-file #2, beginning with the third field, you can set the parameters so that computer will jump to that location."
  369. 8030  PRINT"This is very handy if you are updating just one field within a file.            If you are working with a sub-file, you will also be asked whether you wish"
  370. 8040  PRINT "the physical order or the linkage (master file) order.  Thus if you are working with sub-file #2 and indicate the physical order, then when you want record #5, the computer will allow you to enter/view the 5th record in sub-file #2."
  371. 8050  PRINT:PRINT "However, if you prefer the linkage order, and indicate record #5, the computer  will allow you to enter/view the record(s) within sub-file #2 that are LINKED   to the 5th master file record."
  372. 8060  LOCATE 22,20:PRINT "<<<HIT ANY KEY>>>":COLOR 7,0
  373. 8070  A$=INKEY$:IF A$="" THEN 8070
  374. 8080  GOSUB 1130:COLOR 9: LOCATE 5,1: PRINT "REMEMBER";:COLOR 7,0:PRINT "   These function key are in use during data entry:"
  375. 8090  COLOR 0,7:LOCATE 25,1:PRINT LIN$;:COLOR 7,0
  376. 8100  LOCATE 7,1:COLOR 15:PRINT "F1";:COLOR 7,0:PRINT " Will move up one field within the record"
  377. 8110  COLOR 15:PRINT "F2";:COLOR 7,0:PRINT " Will move down one field within the record"
  378. 8120  COLOR 15: PRINT "F3";:COLOR 7,0:PRINT " Will move up to previous sub-file"
  379. 8130  COLOR 15: PRINT "F4";:COLOR 7,0:PRINT " Will move down to next sub-file record linked to same master file ":PRINT "   record."
  380. 8140  COLOR 15: PRINT "F5";:COLOR 7,0:PRINT " Will move to next record in the same sub file"
  381. 8150  COLOR 15: PRINT "F6";:COLOR 7,0:PRINT " Will move to next record in the Master File."
  382. 8160  COLOR 15: PRINT "F7";:COLOR 7,0:PRINT " Will allow you to pick any record number to enter/view.  If you have chosen":PRINT"   the physical order, it will be the number of the record you specify. If you"
  383. 8170  PRINT "   have chosen the linkage order, it will be the record linked to the record       number of the Master file which you specify."
  384. 8180  COLOR 15:PRINT "F8";:COLOR 7,0: PRINT " Will delete the record you are working on. If you are in the Master File":PRINT"   you will be able to delete all linked sub-records too."
  385. 8190  COLOR 15:PRINT "F9";:COLOR 7,0:PRINT " Will read original record from the disk if it has not yet been re-written."
  386. 8200  COLOR 15:PRINT "F10";:COLOR 7,0:PRINT " Will return to menu"
  387. 8210  LOCATE 23,20:PRINT "<<<HIT ANY KEY>>>"
  388. 8220  A$=INKEY$:IF A$="" THEN 8220 ELSE 8230
  389. 8230  GOSUB 1130:GOSUB 1170:COLOR 9: LOCATE 5,1: PRINT "REMEMBER";:COLOR 7,0:PRINT "   These function key are in use during monitor display"
  390. 8240  COLOR 0,7:LOCATE 25,1:PRINT LIN2$;:COLOR 7,0
  391. 8250  LOCATE 7,1:COLOR 15:PRINT "F1";:COLOR 7,0:PRINT " Will move back one record in the file you are viewing"
  392. 8260  COLOR 15:PRINT "F2";:COLOR 7,0:PRINT " Will move forward one record in the file you are viewing"
  393. 8270  COLOR 15: PRINT "F3";:COLOR 7,0:PRINT " Will move up one file to previous sub-file or master file"
  394. 8280  COLOR 15: PRINT "F4";:COLOR 7,0:PRINT " Will move down one file to next sub-file"
  395. 8290  COLOR 15: PRINT "F5";:COLOR 7,0:PRINT " Will move back one record in the master file"
  396. 8300  COLOR 15: PRINT "F6";:COLOR 7,0:PRINT " Will move forward one record in the master file"
  397. 8310  COLOR 15: PRINT "F7";:COLOR 7,0:PRINT " Will allow you to switch from viewing records in physical order to":PRINT"   linked order or vice versa"
  398. 8330  COLOR 15:PRINT "F8";:COLOR 7,0: PRINT " Will allow you to view remainder of record if it has more than 11":PRINT "   fields and cannot be displayed on one screen at once"
  399. 8340  COLOR 15:PRINT "F9";:COLOR 7,0:PRINT " Will allow you to choose any record number "
  400. 8350  COLOR 15:PRINT "F10";:COLOR 7,0:PRINT " Will return to menu"
  401. 8360  LOCATE 22,20:PRINT "<<<HIT ANY KEY>>>"
  402. 8370  A$=INKEY$:IF A$="" THEN 8370 ELSE 2000
  403. 8400  REM .................ADJUSTING POINTERS.......................
  404. 8410  REM reached by pressing ALT-F10
  405. 8420  GOSUB 1150:LOCATE 22,3: INPUT "Enter Master Record linkage number ===> ";PP$: PP=VAL(PP$): IF  PP>NR(0) THEN GOSUB 1240: GOTO 8420
  406. 8430  IF PP<1 THEN GOSUB 1150:RETURN
  407. 8440   GET #1,PP:GOSUB 6000: LOCATE 21,3: PRINT "Master Record # ===> ";PP
  408. 8450  LOCATE 22,3: INPUT "Is this the MASTER for this sub-file record(Y/N) ";AN$
  409. 8460  IF AN$="y" OR AN$="Y" THEN LSET P$(F)=MKI$(PP)+MKI$(0): PUT #F+1,X ELSE 8420
  410. 8470  GOSUB 1150: RETURN
  411. 8480  REM DISPLAY FILES/FIELDS
  412. 8490  GOSUB 1130:GOSUB 1170:GOSUB 8670
  413. 8500  LOCATE 22,3: INPUT "Indicate number of file you wish to view ";F$:F=VAL(F$):IF F>TF THEN SOUND 50,3:GOSUB 1270: GOTO 8500
  414. 8510  GOSUB 1140:
  415. 8520  GOSUB 8570:GOSUB 1150: LOCATE 22,3: INPUT "Press the 'Enter' key to return to the menu.";AN$: CLOSE:GOTO 2000
  416. 8530  STOP
  417. 8540  REM EXIT
  418. 8550  RESET:RUN "MENU
  419. 8560  COLOR 9:PRINT "F10":COLOR 7,0:PRINT " Return to Menu"
  420. 8570  COLOR 15:LOCATE 5,1:PRINT "FILE: ";F$(F);"     ENTRIES: ";TE(F);"   LENGTH: ";LL(F)"   DRIVE: ";DR$(F)
  421. 8580  LOCATE 7,1: COLOR 9:PRINT "#     TITLE          TYPE     BEGINNING         LENGTH":COLOR 15
  422. 8590  E1=1:GOTO 8600
  423. 8600  IF E1+9>TE(F) THEN E2=TE(F) ELSE E2=E1+9
  424. 8610  GOSUB 1155:FOR Y=E1 TO E2
  425. 8620  LOCATE 7+(Y MOD 10)+(-10*(Y MOD 10 = 0)),1:PRINT Y".  ";LEFT$(T$(F,Y)+"                         ",24);
  426. 8630  LOCATE ,22:IF T(F,Y)=1 THEN PRINT "ALPHA "; ELSE IF T(F,Y)=2 THEN PRINT "NUMBER"; ELSE IF T(F,Y)=3 THEN PRINT "DATE  "; ELSE IF T(F,Y)=4 THEN PRINT "$$$.$$"; ELSE PRINT "      ";
  427. 8640  PRINT  "     ";BB(F,Y);"              ";BL(F,Y):NEXT:COLOR 7,0
  428. 8650  GOSUB 1150: IF E2<TE(F) THEN LOCATE 22,3: INPUT "Press the 'ENTER' key to continue ";AN$: E1=E2+1:COLOR 15:GOTO 8600
  429. 8660  RETURN
  430. 8670  REM
  431. 8680  LOCATE 6,20:COLOR 15: PRINT "You have these files:": FOR F=0 TO TF: LOCATE ,20:PRINT F".   ";F$(F):NEXT:COLOR 7,0:RETURN
  432. 8690  FOR F=0 TO TF
  433. 8700  FOR X=1 TO NR(F)
  434. 8710  GET #F+1,X
  435. 8720  IF LEFT$(P$(F),2)=D$ THEN PRINT F,X,FNNP(F)
  436. 8730  NEXT: NEXT: STOP
  437. 8740  OLDROW=CSRLIN:OLDCOL=POS(0):LOCATE 2,3:PRINT TIME$:LOCATE OLDROW,OLDCOL:RETURN
  438. 8750  OLDROW=CSRLIN:OLDCOL=POS(0):OPEN "ERROR" AS #7 LEN=176:FIELD #7,35 AS ER$(1),70 AS ER$(2),70 AS ER$(3):GET#7,ERR
  439. 8760  LOCATE 20,3:PRINT LEFT$(ER$(1),INSTR(ER$(1),"  ")+(-40*INSTR(ER$(1),"  ")=0));" IN LINE ";ERL;" (Press any key)":LOCATE 21,3:PRINT ER$(2):LOCATE 22,3:PRINT ER$(3):PLAY"MB":J9=2:FOR I9=1 TO 9:PLAY"L64T255O=J9;CC#DD#EFF#GG#AA#B":NEXT
  440. 8770  AE$=INKEY$:IF AE$=""THEN 8770 ELSE FOR EL=20 TO 22:LOCATE EL,3:PRINT STRING$(76,32);:NEXT:LOCATE OLDROW,OLDCOL:CLOSE#3:RESUME
  441. 8780  REM **********************************************************
  442. 8790  REM **********************************************************
  443. 8800  REM ** COPYRIGHT (C) 1984 GERALD E. GONDERINGER             **
  444. 8810  REM ** The Omaha DataBase Program                           **
  445. 8820  REM ** $50.00 REGISTRATION FEE FOR USE OF PROGRAM           **
  446. 8830  REM **********************************************************
  447. 8840  REM **********************************************************
  448. 8850  CLS:COLOR 15,0:LOCATE 10,20:PRINT"*****  ADAPTATIONS ROUTINE *****":SOUND 50,3:COLOR 7,0:LOCATE 15,20:PRINT"** ENTER PASS CODE TO PROCEED **":DEF SEG:POKE &H6A,0:DEF SEG=0:POKE 1052,PEEK(1050)
  449. 8860  K$=INKEY$:IF K$=""THEN 8860 ELSE IF K$="G"OR K$="g"THEN 8870 ELSE 8890
  450. 8870  DEF SEG:POKE 1124,0:CHAIN MERGE"ADD",40095
  451. 8880  SAVE "A:DATA"
  452. 8890  RUN"MENU
  453.